Apple II Magazines (DO)/Peeker Nr. 15 (1986)(Verlag, Dr. Alfred Huethig)(DE).zip/Peeker Nr. 15 (1986)(Verlag, Dr. Alfred Huethig)(DE).do/FIBTEST.TEXT.txt

Text File | 1996-12-24 | 9KB | 301 lines

{$I-}
{$R-}
program FibTest (input, output);

const Maxunit     =    12;
      Maxdir      =    77;
      Vidleng     =     7;
      Tidleng     =    15;
      Fidleng     =    23;
      Fblksize    =   512;
      Fblkmax     =   511;

type  Daterec     = packed record
                      Month : 0..12;
                      Day   : 0..31;
                      Year  : 0..100
                    end; {Daterec}

      Unitnum     = 0..Maxunit;
      Vid         = string [Vidleng];

      Dirrange    = 0..Maxdir;
      Tid         = string [Tidleng];
      Fid         = string [Fidleng];

      Filekind    = (Untypedfile, Xdskfile, Codefile, Textfile,
                     Infofile, Datafile, Graffile, Fotofile,
                     Securedir, Subsvol);

      Direntry    = packed record
                      Dfirstblk : integer;
                      Dlastblk  : integer;
                      case Dfkind : Filekind of
                        Securedir,
                        Untypedfile : (Filler_1  : 0..4095;
                                       Dvid      : Vid;
                                       Deovblk   : integer;
                                       Dnumfiles : Dirrange;
                                       Dloadtime : integer;
                                       Dlastboot : Daterec);
                        Xdskfile,
                        Codefile,
                        Textfile,
                        Infofile,
                        Datafile,
                        Graffile,
                        Fotofile,
                        Subsvol     : (Filler_2  : 0..2047;
                                       Dstatus   : boolean;
                                       Dtid      : Tid;
                                       Dlastbyte : 1..Fblksize;
                                       Daccess   : Daterec)
                    end; {Direntry}

      Dirp        = ^Directory;
      Directory   = array [Dirrange] of Direntry;

      Windowp     = ^Window;
      Window      = packed array [0..0] of char;

      Fibp        = ^Fib;
      Fib         = record
                      Fwindow  : Windowp;
                      Feof,
                      Feoln    : boolean;
                      Fstate   : (Fjandw, Fneedchar, Fgotchar);
                      Frecsize : integer;
                      case Fisopen : boolean of
                        true : (Fisblkd   : boolean;
                                Funit     : Unitnum;
                                Fvid      : Vid;
                                Freptcnt,
                                Fnxtblk,
                                Fmaxblk   : integer;
                                Fmodified : boolean;
                                Fheader   : Direntry;
                                case Fsoftbuf : boolean of
                                  true : (Fnxtbyte,
                                          Fmaxbyte  : integer;
                                          Fbufchngd : boolean;
                                          Fbuffer   : packed
                                            array [0..Fblksize]
                                            of char))
                    end; {Fib}

      Typ         = record
                      X : integer;
                      Y : integer
                    end; {Typ}

var   F1          : text;
      F2          : interactive;
      F3          : file of Typ;
      F4          : file;
      Fileinfo    : Fib;
      S           : string;

{--------------------------------------------------------------}

procedure writelnBool (B : boolean);

begin {writelnBool}
  if B
  then write ('true')
  else write ('false');
  writeln
end; {writelnBool}

{--------------------------------------------------------------}

procedure writelnFstate (State : integer);

begin {writelnFstate}
  write ('Fstate      : ');
  case State of
    0 : write ('Fjandw');
    1 : write ('Fneedchar');
    2 : write ('Fgotchar')
  end; {case}
  writeln
end; {writelnFstate}

{--------------------------------------------------------------}

procedure writeFheader (Header : Direntry);

{--------------------------------------------------------------}

  procedure writelnKind (Kind : Filekind);

  begin {writelnKind}
    write ('Filekind    : ');
    case Kind of
      Untypedfile : write ('Untypedfile');
      Xdskfile    : write ('Xdskfile');
      Codefile    : write ('Codefile');
      Textfile    : write ('Textfile');
      Infofile    : write ('Infofile');
      Datafile    : write ('Datafile');
      Graffile    : write ('Graffile');
      Fotofile    : write ('Fotofile');
      Securedir   : write ('Securedir');
      Subsvol     : write ('Subsvol')
    end; {case}
    writeln
  end; {writelnKind}

{--------------------------------------------------------------}

  procedure writelnTheDate (Date : Daterec);

  begin {writelnDate}
    with Date do writeln (Day, '-', Month, '-', Year)
  end; {writelnDate}

{--------------------------------------------------------------}

  procedure writelnDir;

  begin {writelnDir}
    with Header do
    begin
      writeln ('Directory:');
      writeln ('Dvid        : ', Dvid);
      writeln ('Deovblk     : ', Deovblk);
      writeln ('Dnumfiles   : ', Dnumfiles);
      writeln ('Dloadtime   : ', Dloadtime);
      write   ('Dlastboot   : ');
      writelnTheDate (Dlastboot)
    end {with}
  end; {writelnDir}

{--------------------------------------------------------------}

  procedure writelnFile;

  begin {writelnFile}
    with Header do
    begin
      write   ('Dstatus     : ');
      writelnBool (Dstatus);
      writeln ('Dtid        : ', Dtid);
      writeln ('Dlastbyte   : ', Dlastbyte);
      write   ('Daccess     : ');
      writelnTheDate (Daccess)
    end {with}
  end; {writelnFile}

{--------------------------------------------------------------}

begin {writeFheader}
  with Header do
  begin
    writeln ('Dfirstblk   : ', Dfirstblk);
    writeln ('Dlastblk    : ', Dlastblk);
    writelnKind (Dfkind);
    case Dfkind of
      Securedir,
      Untypedfile : writelnDir;
      Xdskfile,
      Codefile,
      Textfile,
      Infofile,
      Datafile,
      Graffile,
      Fotofile,
      Subsvol    : writelnFile
    end {case}
  end {with}
end; {writeFheader}

{--------------------------------------------------------------}

procedure Lookfile (F : Fib);

var I     : integer;
    C     : char;
    Ready : boolean;

begin {Lookfile}
  with F do
  begin
    writeln ('Fwindow     : ', ord (Fwindow));
    write   ('Feof        : ');
    writelnBool (Feof);
    write   ('Feoln       : ');
    writelnBool (Feoln);
    writelnFstate (ord (Fstate));
    writeln ('Frecsize    : ', Frecsize);
    write   ('Fisopen     : ');
    writelnBool (Fisopen);
    if Fisopen then
    begin
      write   ('Fisblkd     : ');
      writelnBool (Fisblkd);
      writeln ('Fvid        : ', Fvid);
      writeln ('Freptcnt    : ', Freptcnt);
      writeln ('Fnxtblk     : ', Fnxtblk);
      writeln ('Fmaxblk     : ', Fmaxblk);
      write   ('Fmodified   : ');
      writelnBool (Fmodified);
      writeln ('Fheader:');
      writeFheader (Fheader);
      write   ('Fsoftbuf    : ');
      writelnBool (Fsoftbuf);
      if Fsoftbuf then
      begin
        writeln ('Fnxtbyte    : ', Fnxtbyte);
        writeln ('Fmaxbyte    : ', Fmaxbyte);
        write   ('Fbufchngd   : ');
        writelnBool (Fbufchngd);
        writeln ('Fbuffer:');
        I := 0;
        with Fheader do
        while (I <= Fblkmax) and not Ready do
        begin
          if I mod 16 = 0 then writeln;
          C := Fbuffer [I];
          Ready := (Dfkind = Textfile) and (C = chr (0));
          if Dfkind = Textfile
          then write (C : 4)
          else write (ord (C) : 4);
          I := I + 1
        end; {while}
        writeln
      end {if}
    end; {if}
    writeln
  end {with}
end; {Lookfile}

{--------------------------------------------------------------}

begin {FibTest}
  reset (F1, 'TEXTFILE.TEXT');
  moveleft (F1, Fileinfo, size_of (Fileinfo));
  writeln ('TEXTFILE.TEXT');
  Lookfile (Fileinfo);
  close (F1);

  reset (F2, 'INTFILE.TEXT');
  read (F2, S);
  moveleft (F2, Fileinfo, size_of (Fileinfo));
  writeln ('INTFILE.TEXT');
  Lookfile (Fileinfo);
  close (F2);

  reset (F3, 'DATAFILE.DATA');
  moveleft (F3, Fileinfo, size_of (Fileinfo));
  writeln ('DATAFILE.DATA');
  Lookfile (Fileinfo);
  close (F3);

  reset (F4, 'CODEFILE.CODE');
  moveleft (F4, Fileinfo, size_of (Fileinfo));
  writeln ('CODEFILE.CODE');
  Lookfile (Fileinfo);
  close (F4)
end {FibTest}.